HPAVC/HPAVC CD-ROM.iso/FUZZY.ZIP/IO.B

Text File | 1986-11-30 | 10KB | 267 lines

-------------------------------------------------------------------------------
--                                                                           --
--  Library Unit:  io  --  Source and Listing I/O                            --
--                                                                           --
--  Author:  Bradley L. Richards                                             --
--                                                                           --
--     Version     Date     Notes . . .                                      --
--    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    --
--       1.0     6 Feb 86   Initial Version                                  --
--       1.1    25 Feb 86   Minor revisions to error messages                --
--       1.2     4 Mar 86   Added 2 character lookahead (required to         --
--                            differentiate between the Ada ellipse and      --
--                            a floating point number).                      --
--       1.3    22 May 86   Split error handlers into separate package       --
--                            to limit higher level visibility               --
--       1.4    18 Jun 86   Allow variable lookahead (1 or 2 characters)     --
--       2.0    20 Jun 86   Version number change only (for consistancy)     --
--       2.1    13 Jul 86   Fixed bugs pertaining to interactive i/o         --
--                          Split into separate spec and body files          --
--       2.2    28 Jul 86   Reset line number, et al in Start_IO.  Altered   --
--                          end-of=line logic to eliminate the need for the  --
--                          user to type an extra character on interactive   --
--                          input.  Initial operational version.             --
--       3.0    10 Oct 86   Final thesis product                             --
--    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    --
--                                                                           --
--  Library units used:  text_io                                             --
--                                                                           --
--  Description:  This package handles all source file access and listing    --
--     output for an interpreter or compiler.  It assumes a maximum output   --
--     file width of 132 characters; since it reserves the first seven       --
--     character positions for line numbering, it accepts a maximum of       --
--     125 characters on an input line (defined as a constant in the         --
--     package specification).                                               --
--          The package suppresses empty lines entirely.  When it reaches    --
--     the end of a line which did contain data, it returns an ascii.cr as   --
--     the end-of-line delimiter.                                            --
--          To initialize the package, call start_io with the names of the   --
--     source and listing files.  Characters are retrieved by get_char,      --
--     which returns the current character and two lookahead characters.     --
--     The first character retrieved from any file is an ascii.nul (in       --
--     other words, the true first character appears initially as the        --
--     first lookahead character.  When the end of the source file is        --
--     reached get_char returns an ascii.eot.  further read requests         --
--     produce more ascii.eot characters.                                    --
--          Comments may be inserted with the routines "lput," "lput_line,"  --
--     and "lnew_line."  These are equivalent to the normal text_io          --
--     routines, but take the listing format into account.  If desired, a    --
--     pointer to the current character can be printed by "pointer."         --
--          If the listing file name is empty then listing output and        --
--     pointers are suppressed and comments are written to the standard      --
--     output with line and character number references.                     --
--          After everything is finished, stop_io will tidy up the           --
--     files, and handle any post_processing required by the package.        --
--                                                                           --
-------------------------------------------------------------------------------
--                                                                           --
--                              Package Body                                 --
--                                                                           --
-------------------------------------------------------------------------------

package body io is

  package int_io is new integer_io(integer); use int_io;

  line_counter, line_length, prev_line_length, char_ptr : integer;
  read_current, write_current : boolean;
  source_file, listing_file : file_type;
  line_buffer : string(1..max_line_length);
  previous_comment : boolean := false;
  look_ahead : integer;


  procedure get_char is
    begin
      current_char := look_ahead_char;
      if look_ahead = 1 then
    look_ahead_char := internal_get_char;
      else -- look_ahead = 2
        look_ahead_char := look_ahead_2_char;
        look_ahead_2_char := internal_get_char;
      end if;
    end get_char;


  function internal_get_char return character is
      eof_marker : constant character := ascii.eot;
      eof : boolean;
    begin
      if char_ptr = line_length then
    char_ptr := char_ptr + 1;
    return ascii.cr;
      elsif char_ptr >= line_length then       -- past the end of line?
        loop -- until we get a nonempty line
      if read_current then
            eof := end_of_file;                -- check before read
      else
            eof := end_of_file(source_file);
      end if;
      if not eof then
        prev_line_length := line_length;
        if read_current then
              get_line(line_buffer,line_length);
        else
              get_line(source_file,line_buffer,line_length);
        end if;
        line_counter := line_counter + 1;
        if previous_comment then
          if write_current then
        new_line;
          else
            new_line(listing_file);
          end if;
          previous_comment := false;
        end if;
        if not write_current then -- we are creating a listing file
          put(listing_file, line_counter,5); put(listing_file,":  ");
              put_line(listing_file, line_buffer(1..line_length));
        end if;
      end if;
      exit when (line_length > 0) or eof;
    end loop;
    if eof then
      return eof_marker;                   -- return EOT
        else
      char_ptr := 1;
      return line_buffer(char_ptr);        -- return first char of the line
    end if;
      else
        char_ptr := char_ptr + 1;
    return line_buffer(char_ptr);
      end if;
    end internal_get_char;


  procedure lnew_line is
    begin
      if write_current then
        new_line;
      else
        new_line(listing_file);
      end if;
      previous_comment := false;
    end lnew_line;


  procedure lput(comment : in string) is
    begin
      if not previous_comment then
      if not write_current then
            put(listing_file, "      ");    -- space out past line numbers
      end if;
      previous_comment := true;
        end if;
      if write_current then
    put(comment);
      else
        put(listing_file, comment);
      end if;
    end lput;


  procedure lput_line(comment : in string) is
    begin
      if not previous_comment then
      if not write_current then
        put(listing_file, "      ");    -- space out past line numbers
      end if;
    end if;
      if write_current then
    put_line(comment);
      else
        put_line(listing_file, comment);
      end if;
      previous_comment := false;
    end lput_line;


  procedure print_pointer is
      ptr_line : string(1..max_line_length) := (others => ' ');
    begin
      if previous_comment then
        new_line(listing_file);
        previous_comment := false;
      end if;
      if write_current then -- print line and character number
    if char_ptr < look_ahead then
      put("line ");
      put(line_counter - 1, 3);
      put(", character ");
      put(prev_line_length - look_ahead + char_ptr + 1, 4);
      put(" -- ");
    elsif char_ptr = look_ahead then
      put("end of line ");
      put(line_counter - 1, 4);
      put(" -- ");
    else
      put("line ");
      put(line_counter, 4);
      put(", character ");
      put(char_ptr - look_ahead, 3);
      put(" -- ");
    end if;
    previous_comment := true;
      else -- print a pointer
        if char_ptr = (look_ahead - 1) then
      lput_line("Error on last character of previous line");
        elsif char_ptr = look_ahead then
      lput_line("Error on previous end-of-line character");
        else
          if char_ptr > look_ahead then
            for ctr in 1..(char_ptr - look_ahead - 1) loop
              ptr_line(ctr) := '.';
            end loop;
      end if;
          ptr_line(char_ptr - look_ahead) := '^';
          lput_line(ptr_line(1..char_ptr - look_ahead));
        end if;
      end if;
    end print_pointer;


  procedure start_io(source_name, listing_name : string; look_ahead : vision) is
    begin

      line_counter := 0;
      line_length := 0;
      prev_line_length := 0;
      char_ptr :=0;

      io.look_ahead := look_ahead;                     -- set package lookahead

      if listing_name = "" then                        -- use current output
    write_current := true;
      else
    write_current := false;
        create(listing_file, out_file, listing_name);  -- create listing file
      end if;

      if source_name = "" then                         -- use current input
    read_current := true;
      else
    read_current := false;
        open(source_file, in_file, source_name);       -- open source file
      end if;
      for count in 1..look_ahead loop
    get_char;                                      -- get first char ready
      end loop;

    end start_io;


  procedure stop_io is
    begin

      if not read_current then
        close(source_file);
      end if;

      if not write_current then
        close(listing_file);
      end if;

    end stop_io;

end io;